; ORIGINAL: 3dt2.1/examples/pan.scm
; $Id: pan.scm,v 1.3 1996/10/21 15:59:24 aed Exp $
;-pan.scm ---------------------------------------------------------
; Pan in x and y (button 1) or z (any other button)
; (pan #t) turns on panning. and (pan #f) turns off panning.
;------------------------------------------------------------------
(require 'old-rb "old-rb.scm")

(define z-step 1)
(define pan
  (lambda (onoff)
    (let* ((orig-pos #f)
          (orig-view #f)
          (orig-normal #f)
          (orig-target #f)
          (orig-eye #f)
          (orig-y 0)
          (button 0)
          ;; Procedure to shift a view along a vector
          (offset (lambda (delta)
                    (view:set-eye (position:offset orig-eye delta) orig-view)
                    (view:set-target (position:offset orig-target delta)
                         orig-view)
                    (view:refresh orig-view)
                    (set! orig-eye (view:eye orig-view))
                    (set! orig-target (view:target orig-view))
                  )
          ))
      (if onoff
        ;; TRUE: Define mouse hooks for tracking position
        (begin
          ;; When button pressed, save original view info & start tracking
          (set! mouse-down-hook
            (lambda (pe)
              (begin
                (set! orig-view (event:view pe))
                (set! orig-target (view:target orig-view))
                (set! orig-eye (view:eye orig-view))
                (set! orig-normal (gvector:unitize
                    (gvector:from-to orig-target orig-eye)))
                (set! orig-pos (pick:position pe orig-target orig-normal))
                (set! button (event:button pe))
                (set! orig-y (event:y pe))
                (dl:dynamic-silhouette-display #f)
                (rb:scheme #t)
              )
            )
          )
          ;; As mouse moves, update view and refresh
          (set! rb-update-hook
            (lambda (pe)
              (if orig-view
                (if (= button 1)
                  (let ((new-pos (pick:position pe orig-target orig-normal)))
                    (offset (gvector:from-to new-pos orig-pos))
                  )
                  (let ((dz (* (- (event:y pe) orig-y) z-step)))
                    (offset (gvector:scale orig-normal dz))
                    (set! orig-y (event:y pe))
                  )
                )
                #f
              )
            )
          )
          ;; When button released, stop tracking
          (set! mouse-up-hook
            (lambda (pe)
              (rb:scheme #f)
              (dl:dynamic-silhouette-display #t)
              (view:refresh orig-view)
              (set! orig-view #f)
            )
          )
        )
        ;; FALSE: Turn of tracking capability
        (begin
          (set! mouse-down-hook '())
          (set! mouse-up-hook '())
          (set! rb-update-hook '())
        )
      )
      ;; Return the new setting
      onoff
    )
  )
)

